Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/capmou_1/frmcapmo.frm

Visual Basic Form | 1998-09-17 | 5.6 KB | 153 lines

VERSION 5.00
Begin VB.Form frmCapMouse
   AutoRedraw      =   -1  'True
   Caption         =   "SetCapture Demo"
   ClientHeight    =   2550
   ClientLeft      =   1395
   ClientTop       =   1530
   ClientWidth     =   4965
   LinkTopic       =   "Form1"
   ScaleHeight     =   170
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   331
   Begin VB.PictureBox Picture1
      Height          =   1095
      Index           =   3
      Left            =   3780
      ScaleHeight     =   69
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   69
      TabIndex        =   4
      Top             =   180
      Width           =   1095
      Begin VB.Label Label2
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Caption Four"
         Height          =   480
         Index           =   3
         Left            =   210
         TabIndex        =   8
         Top             =   300
         Width           =   600
      End
   End
   Begin VB.PictureBox Picture1
      Height          =   1095
      Index           =   2
      Left            =   2565
      ScaleHeight     =   69
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   69
      TabIndex        =   3
      Top             =   180
      Width           =   1095
      Begin VB.Label Label2
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Caption Three"
         Height          =   480
         Index           =   2
         Left            =   210
         TabIndex        =   7
         Top             =   300
         Width           =   600
      End
   End
   Begin VB.PictureBox Picture1
      Height          =   1095
      Index           =   1
      Left            =   1320
      ScaleHeight     =   69
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   69
      TabIndex        =   2
      Top             =   180
      Width           =   1095
      Begin VB.Label Label2
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Caption Two"
         Height          =   480
         Index           =   1
         Left            =   210
         TabIndex        =   6
         Top             =   300
         Width           =   600
      End
   End
   Begin VB.PictureBox Picture1
      Height          =   1095
      Index           =   0
      Left            =   75
      ScaleHeight     =   69
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   69
      TabIndex        =   0
      Top             =   180
      Width           =   1095
      Begin VB.Label Label2
         Alignment       =   2  'Center
         BackStyle       =   0  'Transparent
         Caption         =   "Caption One"
         Height          =   480
         Index           =   0
         Left            =   210
         TabIndex        =   5
         Top             =   300
         Width           =   600
      End
   End
   Begin VB.Label Label1
      Caption         =   $"frmCapMouse.frx":0000
      Height          =   675
      Left            =   300
      TabIndex        =   1
      Top             =   1605
      Width           =   4170
   End
Attribute VB_Name = "frmCapMouse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
  ' demo project showing how to use the SetCapture API function
  ' by Bryan Stafford of New Vision Software
  ' this demo is released into the public domain "as is" without
  ' warranty or guaranty of any kind.  In other words, use at
  ' your own risk.
  Option Explicit
  ' SetCapture directs ALL mouse input to the window that has the mouse
  ' "captured".  as you will see in the demo this can be very useful for
  ' detecting when the mouse leaves a particular area on one of your forms.
  Private Declare Function ReleaseCapture& Lib "user32" ()
  Private Declare Function GetCapture& Lib "user32" ()
  Private Declare Function SetCapture& Lib "user32" (ByVal hWnd&)
Private Sub Label2_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' pass on the event to the picture box
  Picture1_MouseMove Index, Button, Shift, X, Y
End Sub
Private Sub Label2_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' make sure that we keep the capture since the capture is released whenever the mouse is clicked
  Call SetCapture(Picture1(Index).hWnd)
End Sub
Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' if the mouse is already captured check to see if
  ' it's still within the boundaries of the control
  If GetCapture() = Picture1(Index).hWnd Then
    If ((X < 0) Or (X > Picture1(Index).Width)) Or ((Y < 0) Or (Y > Picture1(Index).Height)) Then
      ' if the mouse is outside the bounds of the control
      ' release the mouse and reset the backcolor
      Call ReleaseCapture
      Picture1(Index).BackColor = &H8000000F
    End If
  Else ' otherwise capture the mouse and change the backcolor of the control
    Picture1(Index).BackColor = &HFFFF&
    Call SetCapture(Picture1(Index).hWnd)
  End If
End Sub
Private Sub Picture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
  ' make sure that we keep the capture since the capture is released whenever the mouse is clicked
  Call SetCapture(Picture1(Index).hWnd)
End Sub